perm filename XAP.FAI[XGP,BGB] blob
sn#041590 filedate 1973-05-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00018 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
C00006 00003 SUBR(MKBUF)-------------------------------------------------------
C00007 00004 SUBR(XGPOUT)------------------------------------------------------
C00009 00005 SUBR(PLAG)GLYPH---------------------------------------------------
C00011 00006 SUBR(PLTVEC,XN,YN)------------------------------------------------
C00016 00007 SUBR(IIISIM)OUTPUT III BUFFER ONTO XGP----------------------------
C00021 00008 SUBR(GETFIL)GET FILE SPEC FROM TTY LINE - BGB - 10 DEC 72.--------
C00024 00009 SUBR(INITIO)GET AND OPEN A CHANNEL--------------------------------
C00025 00010 SUBR(GETCHR)GET CHARACTER AND SKIP.-------------------------------
C00027 00011 SUBR(INITXT)INITIALIZE TEXT FILE----------------------------------
C00029 00012 SUBR(DEFONT)DEFINE A FONT ----------------------------------------
C00033 00013 SUBR(SETFNT)SETUP A FONT -----------------------------------------
C00034 00014 START ADDRESS ENTRY.
C00037 00015 Character Loop
C00041 00016 Escape character table
C00047 00017 A Storage Area
C00048 00018 ∞ Short Desription of Extended Functions for XAP.
C00052 ENDMK
C⊗;
TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
COMMENT/
PHYSICAL PAGE SIZE 8.5" BY 11"
PRINTIBLE PAGE SIZE 7.5" BY 10"
7.5" IS 40 WORDS PER LINE IS 1440 XCOLUMNS.
10" IS 2000 XROWS.
BUFFER SIZE IS (41 WORDS PER ROW)*(2000 ROWS) = 82000 WORDS.
FONT FILE AND UPPER SEGMENT FORMAT.
FONT: 00
GLYPH1
BLOCK 176 ; =128 WORD GLYPH POINTER TABLE.
GLYPH1: XWD ROWS,WORDS ;ROWS IN THE GLYPH, WORD WIDTH OF GLYPH.
XWD R0,C0 ;GLYPH ORIGIN RELATIVE TO PEN POSITION.
XWD R1,C1 ;GLYPH TERMINUS RELATIVE TO PEN POSITION.
BLOCK ROWS*WORDS
/
DECLARE{ORGBUF,ENDBUF,ROW,COL,DROW,DCOL}
O(CORE, CALLI 11)
O(ATTSEG,CALLI 400016)
O(DETSEG,CALLI 400017)
O(SEGNUM,CALLI 400021)
O(CORE2, CALLI 400015)
$←←400000
MAXFILES←←5 ;NUMBER OF INDIRECTED FILES
MAXFONT←←=9 ;NUMBER OF FONTS
ROWINC←←=41 ;SIZE OF ROW IN WORDS
COLEND←←(ROWINC-1)*=36
ROWEND←←=2000
BUFSIZ←←ROWINC*ROWEND
EXTERNAL JOBJDA,JOBFF,JOBSA
SUBR(MKBUF)-------------------------------------------------------
BEGIN MKBUF;MAKE XGP BUFFER - BGB - 27 JANUARY 1973.
;EXPAND CORE FOR XGP BUFFER.
LAC JOBFF↔DAC ORGBUF
ADDI BUFSIZ↔DAC ENDBUF↔AOS ORGBUF
ADDI 10↔DAC JOBFF↔IORI 1777
CALLI 11↔GO [FATAL(CAN'T GET CORE FOR XGP BUFFER)]
;CLEAR XGP BUFFER.
LAC 1,ORGBUF↔SETZM(1)
DIP 1,1↔AOS 1
CDR 2,ENDBUF↔BLT 1,(2)
POP0J
BEND;1/27/73------------------------------------------------------
SUBR(XGPOUT)------------------------------------------------------
BEGIN XGPOUT
;PUT CONTROL WORD IN EACH ROW.
LAC[1B11+=100B23+=40]
LAC 1,ORGBUF
LACI 2,ROWEND ;NUMBER OF ROWS.
DAC(1)↔ADDI 1,ROWINC ;ROW WORD WIDTH.
SOJG 2,.-2
;CALL THE IOTS.
LAC ORGBUF↔SOS↔DAP OUT2
INIT 2,17↔SIXBIT/XGP/↔0↔HALT
SETZ 1,
SEGNUM 1,
DETSEG
LOCK
OUTSTR[ASCIZ/OUTPUTING PAGE TO XGP.../]
OUT 2,OUT1
SKIPA
OUTSTR[ASCIZ/XGP GAVE AN ERROR RETURN.
/]
UNLOCK
RELEASE 2,
OUTSTR[ASCIZ/PAGE FINISHED.
/]
JUMPE 1,.+3
ATTSEG 1,
GO [OUTSTR[ASCIZ/OOPS, MY SEGMENT WENT AWAY. /]
HALT .+1]
;CLEAR XGP BUFFER.
LAC 1,ORGBUF↔SETZM(1)
DIP 1,1↔AOS 1
CDR 2,ENDBUF↔BLT 1,(2)
POP0J
;-----------------------------------------------------------------
OUT1: IOWD 2,HACK1
OUT2: IOWD BUFSIZ,0
OUT3: IOWD 2,HACK2
0
HACK1: 1B0
1B0 + =80B11
HACK2: 1B0 + =80B11
0↔0
BEND;1/31/73------------------------------------------------------
SUBR(PLAG)GLYPH---------------------------------------------------
BEGIN PLAG;PLACE A GLYPH INTO THE XGP BUFFER AT ROW,COL.
;BGB - 27 JANUARY 1973.
ACCUMULATORS{G,B,B2,M,N,I}
LAC G,ARG1
;ORIGIN AND BUFFER POINTER.
NIP 1(G)↔ADD ROW↔DAC ROW
IMULI =41↔ADD ORGBUF↔DAPZ B
NAP 1(G)↔ADD COL↔DAC COL
IDIVI =36↔AOS
ADD B,0↔MOVNS 1↔DAP 1,L3
CAR M,0(G)↔CDR N,0(G)
DIP G,G↔ADDI G,3
DAC B,B2
;INCLUSIVE OR GLYPH BITS INTO THE XGP BUFFER.
L1: LAC I,N
L2: LAC 0,(G)↔SETZ 1,
L3: LSHC 0,0
CAML B,ORGBUF↔CAMLE B,ENDBUF↔SKIPA↔IORM 0,(B)
AOS B
CAML B,ORGBUF↔CAMLE B,ENDBUF↔SKIPA↔IORM 1,(B)
AOS G
SOJG I,L2↔LAC B,B2
ADDI B,ROWINC↔DAC B,B2
SOJG M,L1↔LIP G,G
;TERMINUS.
NIP 2(G)↔ADD ROW↔DAC ROW
NAP 2(G)↔ADD COL↔DAC COL
POP1J
BEND;1/27/73------------------------------------------------------
SUBR(PLTVEC,XN,YN)------------------------------------------------
BEGIN PLTVEC
ACCUMULATORS {DX,DY,D,E,F,T,X0,Y0,ONE,MOVE1}
PTR←1
MOVE X0,COL
MOVE Y0,ROW
MOVE -2(P)
CAIL COLEND
GO [ OUTSTR[ASCIZ/VECTOR OFF SCREEN → /]
POP2J ]
JUMPL [ OUTSTR[ASCIZ/VECTOR OFF SCREEN ← /]
POP2J ]
MOVEM COL
MOVE -1(P)
CAML ROWMAX
GO [ OUTSTR[ASCIZ/VECTOR OFF SCREEN ↓ /]
POP2J ]
JUMPL [ OUTSTR[ASCIZ/VECTOR OFF SCREEN ↑ /]
POP2J ]
MOVEM ROW
CAMLE X0,-2(P)↔GO[EXCH X0,-2(P)↔EXCH Y0,-1(P)↔GO C1]
C1: MOVE PTR,X0
IDIVI PTR,=36
MOVN DX,DX
DPB DX,[POINT 6,PTR,5]
ADD PTR,[XWD 440100,0]
MOVE DX,Y0
IMULI DX,ROWINC
ADD PTR,DX
ADD PTR,ORGBUF
ADDI PTR,1
DPB ONE,PTR
C0: MOVEI ONE,1 ;INITIALIZE CONSTANT FOR LOOP
MOVE DX,-2(P)↔SUB DX,X0 ;DX←XN-X0;
MOVE DY,-1(P)↔SUB DY,Y0 ;DY←YN-Y0;
SKIPN DX
JUMPE DY,POP2J.
MOVE D,DX↔ADD D,DY ;D←DX+DY;
MOVE T,DY↔SUB T,DX ;T←DY-DX;
SETZ MOVE1, ;MOVE1←0;
SKIPL DY ;IF DY≥0
MOVEI MOVE1,2 ; THEN MOVE1←2;
SKIPL D ;IF D≥0
ADDI MOVE1,2 ; THEN MOVE1←MOVE1+2;
SKIPL T ;IF T≥0
ADDI MOVE1,2 ; THEN MOVE1←MOVE1+2;
JUMPGE DX,[MOVN MOVE1,MOVE1 ;IF DX≥0 THEN MOVE1←8-MOVE1
ADDI MOVE1,=8
GO C2] ;
ADDI MOVE1,=10 ; ELSE MOVE1←MOVE1+10;
C2: MOVM DX,DX ;DX←ABS(DX);
MOVM DY,DY ;DY←ABS(DY);
MOVE F,DX↔ADD F,DY ;F←DX+DY;
MOVE D,DY↔SUB D,DX ;D←DY-DX;
JUMPGE D,[MOVE T,DX ;IF D≥0 THEN BEGIN T←DX;
MOVN D,D↔GO C3] ; D←-D; END
MOVE T,DY ; ELSE T←DY;
C3: SETZ E, ;E←0;
LOOP: MOVE DX,D↔ADD DX,E ;DX←D+E;
MOVE DY,T↔ADD DY,E
ADD DY,DX ;DY←T+E+DX;
JUMPGE DY,[MOVE E,DX ;IF DY≥0 THEN BEGIN E←DX;
SUBI F,1 ; F←F-1; COMMENT F←F-1 IS DONE OUTSIDE IF;
JRST @CODE(MOVE1)]; PLOT(MOVE1); END
ADD E,T ; ELSE BEGIN E←E+T; COMMENT F←F-1 IS LATER;
JRST @CODE-1(MOVE1) ; PLOT(MOVE1-1); END
C4: SOJG F,LOOP ;IF F>0 THEN GO LOOP; COMMENT F←F-1 IS DONE HERE;
POP2J
CODE: C
@C+1↔@C+2↔@C+3↔@C+2↔@C+3↔@C+4↔@C+5↔@C+4
@C+5↔@C+6↔@C+7↔@C+6↔@C+7↔@C+8↔@C+1↔@C+8
C: HALT .
[ADDI PTR,ROWINC↔DPB ONE,PTR↔SOJG F,LOOP↔POP2J] ;1 +Y
[ADDI PTR,ROWINC↔IDPB ONE,PTR↔SOJG F,LOOP↔POP2J] ;2 +X+Y
[IDPB ONE,PTR↔SOJG F,LOOP↔POP2J] ;3 +X
[SUBI PTR,ROWINC↔IDPB ONE,PTR↔SOJG F,LOOP↔POP2J] ;4 +X-Y
[SUBI PTR,ROWINC↔DPB ONE,PTR↔SOJG F,LOOP↔POP2J] ;5 -Y
HALT . ;6 -X-Y
HALT . ;7 -X
HALT . ;8 -X+Y
BEND;2/8/73/(TVR)-------------------------------------------------
SUBR(IIISIM)OUTPUT III BUFFER ONTO XGP----------------------------
BEGIN IIISIM
; EXTERNAL FIXDPY
; CALL(GETCHM)↔ASH 1,5↔MOVEM 1,MULFAC#
CALL(GETCHM)↔IMULI 1,COLEND↔ASH 1,-6↔MOVEM 1,MULFAC#
CALL(GETFIL)↔POP0J
CALL(INITIO,[17],[SIXBIT/DSK/],[0])
GO[FATAL(CAN'T INIT DSK)]
MOVEM 1,IIICHN#
CALL(IO,[LOOKUP FILNAM],IIICHN)
GO FRET
HLRE 1,PPPN
MOVN 1,1
ADD 1,JOBFF
MOVEM 1,BUFEND#
CORE 1,
GO [FATAL(CAN'T EXPAND CORE)]
MOVE JOBFF
ADDM PPPN
CALL(IO,[IN PPPN],IIICHN)
; CALL(FIXDPY,JOBFF)
MOVE COL
MOVEM BEGCOL#
MOVE ROW
MOVEM BEGROW#
MOVE 1,JOBFF
ADDI 1,2
MOVEM 1,PC#
OUTSTR[ASCIZ/READING III BUFFER.../]
ILOOP: AOSA 1,PC
LOOP: MOVE 1,PC
CAMLE 1,JOBFF
CAML 1,BUFEND↔GO RET
MOVE 2,(1)
TRNE 2,1 ;TEXT?
GO [ PUSH P,2 ;-2(P)
PUSH P,[5] ;-1(P)
PUSH P,[POINT 7,-2(P)] ; 0(P)
CLOOP: ILDB 1,(P)
JUMPE 1,CCONT
CAIN 1,15
GO [ MOVE -4(P)
MOVEM COL
GO CCONT]
CALL (PLAG,1)
CCONT: SOSL -1(P)
GO CLOOP
SUB P,[XWD 3,3]
GO ILOOP]
TRNE 2,2 ;VECTORS?
GO [ TRNN 2,4
GO [TRNN 2,10 ;SHORT VECTOR OR TSS
GO SVECT ;SHORT VECTOR
GO ILOOP] ;TSS
LDB [POINT 11,2,10] ;LONG VECTOR
ROT -13
PUSHJ P,GRONK
LDB [POINT 11,2,21]
ROT -13
MOVN
PUSHJ P,GRONK
LDB 1,[POINT 3,2,31]
PUSHJ P,@PLOTAB(1)
GO ILOOP]
TRNE 2,20
GO [ TRNN 2,4
GO [ HLRZ 1,2 ;JUMP
MOVEM 1,PC
GO LOOP]
TRNE 2,40
GO LOOP ;SAVE A NOP HERE
AOS 1,PC ;JSR
HRLI 1,20
HLRZ 2,2
CAMLE 2,JOBFF
CAML 2,BUFEND
GO [ OUTSTR[ASCIZ/JSR OUT OF BOUNDS
/]↔ GO RET]
MOVEM 1,(2)
MOVEM 2,PC
GO ILOOP]
TRNE 2,37 ;HALT?
GO ILOOP ;NO, REST A NOP HERE
RET: AOS (P) ;YES, RETURN
OUTSTR [ASCIZ/FINISHED
/]
FRET: CALL(IO,[RELEASE],IIICHN)
MOVE 1,JOBFF
CORE 1,
GO [FATAL(CAN'T SHRINK CORE!)]
MOVE BEGCOL
MOVEM COL
MOVE BEGROW
MOVEM ROW
POP0J
SVECT: PUSH P,2
LDB [POINT 7,2,6]
ROT -7
PUSHJ P,GRONK
LDB [POINT 7,2,13]
ROT -7
MOVN
PUSHJ P,GRONK
LDB 1,[POINT 2,2,15]
PUSHJ P,@PLOTAB(1)
POP P,2
LDB [POINT 7,2,22]
ROT -7
PUSHJ P,GRONK
LDB [POINT 7,2,29]
ROT -7
PUSHJ P,GRONK
LDB 1,[POINT 2,2,31]
PUSHJ P,@PLOTAB(1)
GO ILOOP
GRONK: ADD [XWD 200000,0]
MUL MULFAC
EXCH 0,(P)
JRST @0
PLOTAB: [RVECT: CALL(RELATE)↔CALL(PLTVEC,1,2)↔POP2J]
[RPNT: CALL(RELATE)↔MOVEM 1,COL↔MOVEM 2,ROW↔GO PLTVEC]
[RIVECT: CALL(RELATE)↔MOVEM 1,COL↔MOVEM 2,ROW↔POP2J]
RPNT
[AVECT: CALL(ABSOLUTE)↔GO PLTVEC] ;ARGS ARE ALREADY STACKED
[APNT: CALL(ABSOLUTE)↔MOVEM 1,COL↔MOVEM 2,ROW↔GO PLTVEC]
[AIVECT: CALL(ABSOLUTE)↔MOVEM 1,COL↔MOVEM 2,ROW↔POP2J]
APNT
RELATE: MOVSI -200000↔MUL MULFAC↔MOVE 1,0↔ADD 1,COL↔ADDB 1,-3(P)
MOVE 2,0↔ADDB 2,-2(P)↔ADD 1,ROW↔POP0J
ABSOLU: MOVE 1,BEGCOL↔ADDB 1,-3(P)↔MOVE 2,BEGROW↔ADDB 2,-2(P)↔POP0J
BEND;2/8/73/(TVR)-------------------------------------------------
SUBR(GETFIL)GET FILE SPEC FROM TTY LINE - BGB - 10 DEC 72.--------
BEGIN GETFIL
SETZM FILNAM↔SETZM EXTION
SETZM EXTION+1↔SETZM PPPN
; CRLF
LAC 4,[POINT 6,FILNAM,-1]↔LACI 2,6
CALL(GETCHR)↔POP0J↔CAIN 1,15↔GO[CALL(GETCHR)↔POP0J↔POP0J]↔AOS(P)
JRST L+2
L: CALL(GETCHR)↔POP0J
CAILE 1,"z"↔POP0J
CAIL 1,"a"↔SUBI 1,40 ;CONVERT LOWER CASE
CAIN 1,"."↔GO[LAC 4,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
CAIN 1,"["↔GO[LAC 4,[POINT 6,PPPN,-1] ↔LACI 2,3↔GO L]
CAIN 1,","↔GO[HLRZ PPPN
PUSHJ P,[PPJUST: JUMPE [OUTSTR[ASCIZ/BAD P,PN/]
CLRBFI↔SOS -1(P)↔CRLF↔POP1J]
TRNE 77↔POP0J↔LSH -6↔GO PPJUST]
HRLM PPPN↔LAC 4,[POINT 6,PPPN,17]↔LACI 2,3↔GO L]
CAIN 1,"]"↔GO[HRRZ PPPN↔CALL(PPJUST)
HRRM PPPN↔CALL(GETCHR)↔POP0J↔GO FINQ]
FINQ: CAIN 1,15↔GO EOL ;END OF THE LINE.
CAIN 1,12↔POP0J
CAIN 1,"→"↔POP0J
CAIG 1," "↔GO L ;IGNORE GARBAGE.
SOJL 2,L↔SUBI 1,40↔IDPB 1,4↔GO L
EOL: CALL(GETCHR)↔POP0J↔POP0J
BEND;1/31/73,2/7/73(TVR)----------------------------------------------
SUBR(INITIO)GET AND OPEN A CHANNEL--------------------------------
BEGIN INITIO
MOVEI 1,17 ;SEARCH FOR FREE CHANNEL
SKIPE JOBJDA(1)
SOJGE 1,.-1
JUMPL 1,[OUTSTR[ASCIZ+OUT OF I/O CHANNELS!
+]
POP3J]
MOVE [ OPEN -3(P)]
DPB 1,[POINT 4,0,12]
XCT 0
POP3J
AOS (P)
POP3J
BEND;2/7/73/(TVR)-------------------------------------------------
SUBR(IO,OPCODE,CHAN)----------------------------------------------
BEGIN IO
MOVE -1(P)
DPB [POINT 4,-2(P),12]
XCT -2(P)
POP2J
AOS (P)
POP2J
BEND;2/7/73/(TVR)-------------------------------------------------
SUBR(GETCHR)GET CHARACTER AND SKIP.-------------------------------
BEGIN GETCHR
SKIPE TTYFLAG↔GO[INCHWL 1↔AOS(P)↔POP0J]
SKIPGE 1,IOPTR↔POP0J
SOSLE IBUF+2(1)
GO[RETCHR: ILDB 1,IBUF+1(1)↔AOS(P)↔POP0J]
CALL(IO,[IN],<CHANTB(1)>)
GO RETCHR
CALL(IO,[STATO 1B22],<CHANTB(1)>)
GO [OUTSTR[ASCIZ/READ ERROR /]
HALT RETCHR]
CALL(IO,[RELEASE],<CHANTB(1)>) ;EOF.
SUBI 1,4
DAC 1,IOPTR
GO GETCHR
POP0J
BEND;2/7/73(TVR)--------------------------------------------------
SUBR(GETCHM)GET CHARACTER AND BARF IF EOF AND NO I/O LEFT---------
BEGIN GETCHM
CALL(GETCHR)
GO [FATAL(UNEXPECTED EOF)]
POP0J
BEND;2/7/73(TVR)--------------------------------------------------
SUBR(RDNUM)-------------------------------------------------------
BEGIN RDNUM;
CALL(GETCHM)↔HRREI 2,-100(1)↔ASH 2,7↔CALL(GETCHM)↔MOVE 0,2
ADD 1↔POP0J
BEND RDNUM;-------------------------------------------------------
SUBR(RDPAIR)------------------------------------------------------
BEGIN RDPAIR;
CALL(RDNUM)↔MOVE 3,0↔JUMPL XLOSE↔CAILE COLEND
GO[XLOSE: CALL(RDNUM)↔POP0J]
CALL(RDNUM)↔JUMPL YLOSE↔CAILE ROWEND
GO[YLOSE: POP0J]
AOS(P)↔POP0J
BEND RDPAIR;------------------------------------------------------
SUBR(INITXT)INITIALIZE TEXT FILE----------------------------------
BEGIN INITXT
LACI 2,4↔ADD 2,IOPTR
CAIL 2,4*MAXFILES↔GO[FATAL(TOO MANY INDIRECT FILES!)]
LACI IBUF(2)
CALL (INITIO,[0],[SIXBIT/DSK/],0)↔GO[FATAL(CAN'T INIT DSK)]
DAC 1,CHANTB(2)
SKIPE TTYFLAG↔OUTSTR [ASCIZ/TEXT: /]
CALL(GETFIL)↔GO FRET
CAIE 1,12↔GO[OUTSTR[ASCIZ/ILLEGAL FILE TERMINATOR:/]
OUTCHR 1↔GO FRET]
LACI 2,4↔ADDB 2,IOPTR
CALL (IO,[LOOKUP FILNAM],<CHANTB(2)>)
GO[OUTSTR[ASCIZ/FILE NOT FOUND.
/]
FRET: LACI 2,4↔SUBM 2,IOPTR↔CALL(IO,[RELEASE],<CHANTB(2)>)
POP0J]
AOS(P)
POP0J
BEND;2/7/73(TVR)--------------------------------------------------
SUBR(DEFONT)DEFINE A FONT ----------------------------------------
BEGIN DEFONT
PUSH P,[17]
PUSH P,[SIXBIT/DSK/]
PUSH P,[0]
PUSHJ P,INITIO ;INITIALIZE
GO [FATAL(CAN'T INIT DSK)]
MOVEM 1,FONTCH
SKIPE TTYFLAG
OUTSTR [ASCIZ/FONT: /]
CALL(GETFIL)↔POP0J
CAIE 1,"→"↔CAIN 1,12↔GO OK
OUTSTR[ASCIZ/ILLEGAL FILE TERMINATOR:/]↔CALL(ONECHR)↔CLRBFI↔GO FRET]
OK: CALL (IO,[LOOKUP FILNAM],FONTCH)
GO [ HRLI 'XAP'↔SKIPN EXTION↔HLLZM EXTION
CALL (IO,[LOOKUP FILNAM],FONTCH)
GO [ MOVE FNTPPN↔SKIPN PPPN↔MOVEM PPPN
CALL (IO,[LOOKUP FILNAM],FONTCH)
GO [ OUTSTR[ASCIZ/NOT FOUND, TRY AGAIN
/]
POP0J]
GO .+1]
GO .+1]
CAIN 1,"→"↔GO [ CALL(GETCHM) ;DEFINING FONT NUMBER ≠0?
CAIL 1,"0"↔CAIL 1,"0"+MAXFONT
GO [OUTSTR[ASCIZ/ILLEGAL FONT NUMBER:/]
CLRBFI↔CALL(ONECHR)↔CRLF↔GO FRET]
INCHSL↔JFCL↔CAIE 12↔INCHSL↔JFCL
SUBI 1,"0"↔GO CONT]
SETZ 1,
↑RPGFNT: ;ENTRY FOR RPG MODE
CONT: DAC 1,FONTNO
SETZ↔SEGNUM ;GET SEGMENT NUMBER
CAMN FONTAB(1)↔GO SEGOK ;IF SAME AS TABLE, WE WIN
SKIPE 0↔DETSEG ;DETACH CURRENT SEGMENT IF ANY
MOVE FONTAB(1) ;GET NUMBER OF DESIRED SEGMENT
JUMPE SEGOK
ATTSEG
GO [OUTSTR[ASCIZ/OOPS, MY SEGMENT WENT AWAY! /]
HALT SEGOK]
SEGOK: LAC PPPN↔LAPI $↔SOS↔DAC INARG ;IOWD.
MOVS PPPN↔MOVMS↔ADDI $
DAC MAXADR↔CORE2↔HALT ;MAKE UPPER SEG.
SKIPN FONTAB(1)↔GO[SETZ↔SEGNUM
MOVEM FONTAB(1) ;REMEMBER SEG, NUMBER
LAC[SIXBIT/FONT00/]↔ADD 1
CALLI $+36↔JFCL↔GO RDFONT] ;NAME UPPER SEG.
RDFONT: CALL (IO,[IN [INARG:0↔0]],FONTCH])
LACI 1,177 ;CONSISTANCY CHECKING HERE
CKLOOP: SKIPLE 2,$(1)↔GO[ADDI 2,$↔CAML 2,MAXADR↔GO BADFNT
HRRZ (2)↔HRRZ 3,(2)↔IMUL 3↔ADDI $+3(2)
CAML MAXADR↔GO BADFNT
SOJGE 1,CKLOOP↔GO FONTOK]
ADDI 2,SPTABE-SPTABL↔JUMPL 2,BADFNT↔SOJGE 1,CKLOOP
FONTOK: CALL(SETFNT)
AOS (P)
FRET: CALL (IO,[RELEASE],FONTCH)
POP0J
BADFNT: OUTSTR[ASCIZ/BAD CHARACTER IN FONT #/]
LACI 0,"0"↔ADD 0,FONTNO↔OUTCHR 0
OUTSTR[ASCIZ/:/]↔CALL(ONECHR)↔SETZM $(1)
CRLF↔SOJGE 1,CKLOOP↔GO FONTOK
↑FONTCH: 0
MAXADR: 0
BEND DEFONT;2/7/72(TVR)-------------------------------------------
SUBR(ONECHR)------------------------------------------------------
BEGIN ONECHR
JUMPE 1,[OUTSTR [ASCIZ/<NULL>/]↔POP0J]
CAIN 1," "↔GO[OUTSTR[ASCIZ/<SPACE>/]↔POP0J]
CAIL 1,11↔CAILE 1,15↔GO[OUTCHR 1↔POP0J]
OUTSTR @[[ASCIZ/<TAB>/]
[ASCIZ/<LF>/]
[ASCIZ/<VT>/]
[ASCIZ/<FF>/]
[ASCIZ/<CR>/]]-11(1)
POP0J
BEND ONECHR;2/7/72(TVR)-------------------------------------------
SUBR(SETFNT)SETUP A FONT -----------------------------------------
BEGIN SETFNT
LACI =40↔DAC DROW ;LINE FEED DEFAULT.
LAC 2,$+12↔JUMPN 2,[ ;LINE FEED SPECIFIED.
NIP 0,$+1(2)↔NIP 1,$+2(2)
ADD 0,1↔DAC 0,DROW↔GO .+1]
LACI =25↔DAC DCOL ;SPACE DEFAULT.
LAC 2,$+40↔JUMPN 2,[ ;SPACE SPECIFIED.
NAP 0,$+1(2)↔NAP 1,$+2(2)
ADD 0,1↔DAC 0,DCOL↔GO .+1]
POP0J
BEND SETFNT;2/7/72(TVR)-------------------------------------------
;START ADDRESS ENTRY.
SA: JRST NOTRPG
RPGSA: SETOM RPGSW
CAIA
NOTRPG: SETZM RPGSW
CALLI 0 ;RESET I/O AND CORE
HLRZ JOBSA
MOVEM JOBFF
CORE ;CORE DOWN
JFCL
LAC 17,[IOWD 100,PDL] ;INITIALIZE TABLES
SETZM FONTAB↔LAC [XWD FONTAB,FONTAB+1]↔BLT FONTAB+9
SETZM LMAR↔LACI =1440↔DAC RMAR
;RE-ENTRY ADDRESS.
REE: LACI .↔DAC 124
LACI 4↔MOVNM IOPTR
SETOM TTYFLAG
SKIPE RPGSW
GO [ SETZM RPGSW
CALL(INITIO,[0],[SIXBIT/DSK/],[IBUF])
GO[FATAL(CAN'T INIT DSK!)]
MOVEM 1,CHANTB
CALL(IO,[LOOKUP 4],CHANTB);
GO[OUTSTR[ASCIZ/TEXT FILE NOT FOUND - GETRPG
/]↔ GO SA]
SETZM IOPTR
CALL(INITIO,[17],[SIXBIT/DSK/],[0])
GO[FATAL(CAN'T INIT DSK!)]
MOVEM 1,FONTCH
CALL(IO,[LOOKUP 10],FONTCH);
GO[OUTSTR[ASCIZ/FONT FILE NOT FOUND - GETRPG
/]↔ GO SA]
MOVEM 13,PPPN ;SAVE LENGTH
MOVE 1,14
JUMPL 1,[RPGLOSE: OUTSTR[ASCIZ/ILLEGAL FONT NUMBER
/]
GO SA]
CAILE 1,MAXFONT
GO RPGLOSE
CALL(RPGFNT)
GO [OUTSTR[ASCIZ/BAD FONT FILE
/]↔ GO SA]
OUTSTR [ASCIZ/XAP INITIALIZED IN RPG MODE.
/]
GO RPGCON]
;INITIALIZE XGP BUFFER.
restar: CALL(DEFONT)↔GO .-1
CALL(INITXT)↔GO .-1
RPGCON: SETZM TTYFLAG
CALL(MKBUF)
;Character Loop
LACI =100↔DAC ROWMIN↔DAC ROW
LACI ROWEND-=200↔DAC ROWMAX
LACI =100↔DAC LMAR↔DAC COL
LACI COLEND↔DAC RMAR
L2: CALL(GETCHR)
GO FINISH ;EOF.
JUMPE 1,L2 ;NULL.
CAIN 1,11↔GO[LAC COL↔SUB LMAR↔IDIV DCOL ;TAB.
ANDCMI 7↔ADDI 8↔IMUL DCOL↔ADD LMAR
DAC COL↔GO L2]
CAIN 1,15↔GO[LAC LMAR↔DAC COL↔GO L2] ;RETURN.
CAIN 1,14↔GO[FORMFEED: CALL(XGPOUT) ;FF.
LAC ROWMIN↔DAC ROW
LAC LMAR↔DAC COL↔GO L2]
CAIN 1,40↔GO[SPACE: LAC DCOL↔ADDM COL↔GO COLCHK];SPACE.
CAIN 1,12↔GO[LAC DROW↔ADDM ROW↔GO ROWCHK] ;LINE FEED
CAIN 1,177↔GO ESC1 ;B.S. (default special char.)
;FONT TABLE LOOKUP AND PLACE CHARACTER'S GLYPH INTO XGP BUFFER.
HIDDEN: HRRE 0,$(1)
JUMPLE SPCHAR↔ADDI $
CALL(PLAG,0)
;COLUMN OVERFLOW - DEFAULT CRLF.
COLCHK: LAC COL↔CAMLE RMAR↔GO[LAC LMAR↔DAC COL↔LAC DROW
ADDM ROW↔GO ROWCHK]
ROWCHK: LAC ROW↔CAMGE ROWMAX↔GO L2↔GO FORMFEED ;ROW OVERFLOW.
FINISH: CALL(XGPOUT)↔CALLI 0 ;FLUSH BUFFERS
MOVE JOBFF
CORE↔OUTSTR[ASCIZ/COULDN'T SHRINK CORE/] ;AND THEIR CORE
MOVEI 1,MAXFONT
FINIS2: MOVE FONTAB(1)↔ATTSEG↔JFCL↔SETZ↔CORE2
JFCL↔SOJGE 1,FINIS2 ;FLUSH UPPER(S)
CALLI 12 ;EXIT
;A COMMAND CHARACTER, INTERPET IT
SPCHAR:
ADDI SPTABEND
MOVE @0
JRST @0
SPTABL:
ESC1 ;-1 BINARY FORM OF ESCAPE
SPTABE: [MOVE $+" "
MOVEM $(1)
OUTSTR[ASCIZ/UNDEFINED CHARACTER:/]
CALL(ONECHR)
CRLF
JRST SPACE] ; 0 UNDEFINED CHARACTER
ESC1: CALL(GETCHM)
SKIPE ESC1TB(1)
JRST @ESC1TB(1)
OUTSTR [ASCIZ/UNDEFINED COMMAND:/]
CALL(ONECHR)
CRLF
JRST L2
;Escape character table;
ESC1TB: HIDDEN ;CENTER DOT
0↔0↔0↔0↔0↔0↔0 ;0-6 ↓αβ∧¬επ
[CALL(DEFONT) ;7 λ (DEFINE A FONT)
GO [OUTSTR[ASCIZ/FONT NOT FOUND.
/]↔ GO L2]
GO L2]
HIDDEN↔0↔HIDDEN↔HIDDEN↔HIDDEN ;11-15 (HIDDEN CHARACTERS)
0↔0 ;16-17 ∞∂
[MOVEI 2↔GO PARTPG] ;20 ⊂ (1/2 PAGE)
[OUTSTR[ASCIZ/CAN'T CROSS PAGE BOUNDARIES, SORRY/]
MOVE DROW↔ADDM ROW↔GO ROWCHK] ;21 ⊃
[MOVEI 3↔IMUL DROW↔ADDM ROW
GO ROWCHK] ;22 ∩ (3 LINES)
[MOVEI 3↔GO PARTPG] ;23 ∪ (1/3 PAGE)
[MOVEI 6↔GO PARTPG] ;24 ∀ (1/6 PAGE)
0↔[PUSHJ P,IIISIM↔JFCL↔GO L2]↔0 ;25-27 ∃⊗↔
0↔0↔0↔0↔0↔0↔0↔0 ;30-37 _→~≠≤≥≡∨
[PUSHJ P,SXINC↔GO COLCHK] ;40 (SPACE, INC X POS)
0↔0↔0↔0↔0↔0↔0 ;41-47 !"#$%&'
0↔0↔0↔0↔0↔0↔0↔0 ;50-57 ()*+,-./
CHGFNT↔CHGFNT↔CHGFNT↔CHGFNT ;60-63 0123 (SET FONT NUMBER)
CHGFNT↔CHGFNT↔CHGFNT↔CHGFNT ;64-67 4567 (SET FONT NUMBER)
CHGFNT↔CHGFNT ;70-71 89 (SET FONT NUMBER)
0↔0↔0↔0↔0↔0 ;72-77 :;<=>?
REQFIL↔0↔0↔0↔0↔0↔0↔0 ;100-107 @ABCDEFG
0↔IVECT↔0↔0↔0↔SETMAR↔0↔0 ;110-117 HIJKLMNO
PVECT↔0↔0↔0↔0↔0↔VECT↔0 ;120-127 PQRSTUVW
0↔0↔0↔0↔0↔0↔0↔0 ;130-137 XYZ[\]↑←
0↔0↔0↔0↔0↔0↔0↔0 ;140-147 `abcdefg
0↔0↔0↔0↔0↔0↔0↔0 ;150-157 hijklmno
0↔0↔0↔0↔0↔0↔0↔0 ;160-167 pqrstuvw
0↔0↔0↔0 ;170-173 xyz{
0↔L2↔0 ;174-176 |~}
[CALL (GETCHM)↔ADD COL↔JUMPL L2
MOVEM COL↔GO L2] ;177
;SPACE PART OF PAGE DOWN
PARTPG: MOVE 1,ROW↔SUB 1,ROWMIN↔IMUL 1,0↔MOVE 3,ROWMAX
SUB 3,ROWMIN↔IDIV 1,3↔ADDI 1,1↔IMUL 1,3↔IDIV 1,0
ADD 1,ROWMIN↔MOVEM 1,ROW↔GO ROWCHK
;INC. POSITION
SXINC: CALL(GETCHM)↔ADDM 1,COL↔POPJ P,
SYINC: CALL(GETCHM)↔ADDM 1,ROW↔POPJ P,
;SWITCH FONTS
CHGFNT: CAILE 1,MAXFONT+"0"↔GO[OUTSTR[ASCIZ/ILLEGAL FONT NUMBER:/]
CALL(ONECHR)↔GO L2]
SKIPE 2,FONTAB-"0"(1)
GO [DETSEG
ATTSEG 2,↔GO[OUTSTR[ASCIZ/OOPS, MY SEGMENT WENT AWAY!/]
HALT .+1]
CALL(SETFNT)↔GO L2]
OUTSTR [ASCIZ/UNDEFINE CHARACTER SET #/]
OUTCHR 1
GO L2
;INDIRECT FILE
REQFIL: CALL(INITXT)↔GO[OUTSTR[ASCIZ/REQUIRED TEXT FILE NOT FOUND
/]↔GO L2]
OUTSTR[ASCIZ/REQUIRE TEXT COMMAND SEEN.
/]↔ GO L2
;SET MARGINS
SETMAR: CALL(GETCHM)↔MOVE 3,1↔CALL(RDNUM)
JUMPL 1,BADMAR
CAIN 3,"L"↔GO[CAML RMAR↔GO BADMAR↔MOVEM LMAR↔MOVEM COL↔GO L2]
CAIN 3,"R"↔GO[CAIG 1,COLEND↔CAMG LMAR↔GO BADMAR↔MOVEM RMAR↔GO L2]
CAIN 3,"T"↔GO[CAML ROWMAX↔GO BADMAR↔MOVEM ROWMIN↔CAML ROW
MOVEM ROW↔GO L2]
CAIN 3,"B"↔GO[CAIG ROWEND↔CAMG ROWMIN↔GO BADMAR↔MOVEM ROWMAX
CAML ROW↔GO L2↔GO FORMFEED]
BADMAR: OUTSTR[ASCIZ/ILLEGAL MARGIN COMMAND /]↔OUTCHR 3↔CRLF↔GO L2
VECT: CALL(RDPAIR)↔GO VLOSE↔CALL(PLTVEC,3,0)↔GO L2
IVECT: CALL(RDPAIR)↔GO VLOSE↔MOVEM 3,COL↔MOVEM ROW↔GO L2
PVECT: CALL(RDPAIR)↔GO VLOSE↔MOVEM 3,COL↔MOVEM ROW↔CALL(PLTVEC,3,0)
GO L2
VLOSE: OUTSTR[ASCIZ/VECTOR OFF SCREEN
/]↔ GO L2
;A Storage Area
RMAR: COLEND
LMAR: =100
ROWMIN: =100
ROWMAX: ROWEND
FILNAM: 0 ;FILE NAME.
EXTION: 0 ;EXTENSION.
0
PPPN: 0 ;PROJECT-PROGRAMMER.
0
FNTPPN: SIXBIT/XGPTVR/ ;DEFAULT FONT PPN
IOPTR: 0 ;POINTER INTO FILE STACK
IBUF: BLOCK 4*MAXFILES ;FILE STACK
CHANTB←IBUF+3
TTYFLA: 0 ;INPUT FROM TTY
RPGSW: 0
FONTNO: 0
FONTAB: BLOCK =10
PDL: BLOCK 100 ;CONTROL PUSH DOWN.
PAT: BLOCK 100 ;PATCH AREA.
COMMENT ∞ Short Desription of Extended Functions for XAP.
These commands are preceded with '177 (or equivalent).
The escape characters which print hidden characters on LPT will
output the same characters on the XGP if they are defined in the
character set currently being used. The line spacing commands
for the LPT should also do the same on the XGP with the exception
of '177 '21 (line space over page boundary).
0-9 Select character set number specified by digit.
λ<file>→<digit> Define character set number and load set into upper
segment.
<space><char.> Takes octal value of character to be number of bits
to move right.
<rubout><char.> Takes octal value of character to be number of bits
to move left.
MR<number> Set Right margin to <number> (in XGP co-ordinates).
ML<number> Set Left margin to <number> (in XGP co-ordinates).
MB<number> Set Bottom margin to <number> (in XGP co-ordinates).
MT<number> Set Top margin to <number> (in XGP co-ordinates).
V<number><number> Visible vector to <number>,<number> (in XGP points).
I<number><number> Invisible vector to <number>,<number> (in XGP points).
P<number><number> Point vector to <number>,<number> (in XGP points).
<altmode> No-op (when placed in text, if not deleted explicitly
protects a line from being changed by TV or E).
@<file><crlf> Inserts file at this point in listing.
⊗<char><file><crlf> Inserts III buffer at this point in file, relocated
by current position and multiplied by char/64. When
finished leaves cursor at same position.
<number> Defined by two character. Equal to:
(CHAR1-'100)*'200+CHAR2. A SAIL procedure to generate
a number would be:
STRING PROCEDURE MAKNUM(INTEGER X);
RETURN(((X % 200)+'100) & (X LAND '177));
RPG Mode:
Start at starting address + 1 with:
4:7 Text file name↔ extesion↔ 0↔ ppn
10:13 Font file name↔ extesion↔ 0↔ ppn (must be completely specified)
14 Font number for font
∞;
END SA